home *** CD-ROM | disk | FTP | other *** search
/ Aminet 5 / Aminet 5 - March 1995.iso / Aminet / text / hyper / ag2html.lha / ag2html.pl next >
Perl Script  |  1994-11-29  |  11KB  |  258 lines
  1. #!/usr/local/bin/perl
  2. # <title> AG2HTML.pl </title>
  3. # <h1> AG2HTML.pl Amiga Guide to HTML Converter</h1>
  4. # <listing>
  5. # <b>This code is (c) 1993,1994 to Michael Witbrock</b>
  6. # <b>This code is © 1993,1994 to Michael Witbrock</b>
  7. # <b>You may use it and modify and redistribute it freely,</b>
  8. # <b>but you may not sell it in any way (including in disk collections)</b>
  9. # <b>without first recieving my permission.</b>
  10. # <b>Fred Fish, and the makers of the Aminet CD are granted that permission.
  11. # <b>If you significantly improve it, please let me know so that I can</b>
  12. # <b>use the new version.</b>
  13. # <b>You may contact me as witbrock@cs.cmu.edu</b>
  14.  
  15. $VERSION = "2.941126c";
  16.  
  17. #http://www.cs.cmu.edu:8001/Web/People/mjw/Computer/Amiga/Perl/AG2HTML.pl
  18. #is a URL to the latest version of this program.
  19.  
  20. # P.S. I know that this is redundant. It's my second perl script, and I don't
  21. #     yet know how to do subroutines. When I do, it will be both neater and shorter.
  22. # P.P.S the reason it is preformatted is because many AG documents have button
  23. #     layouts which depend on this. Perhaps later I will make it smarter, so that
  24. #     it can recognise obvious text paragraphs and do the right thing.
  25. # DONE: P.P.P.S handling some of the style flags, and the next, menu, prev, help, etc buttons
  26. #      is next, along with removing what can't be done (background colours etc).
  27.  
  28.  
  29. #Changes: October 16 1993 MJW
  30. #         Allow email addresses.
  31. #         Translate & to & > to > < to < 
  32. #Changes: November the 9th 1993 MJW
  33. #         Allow some strange links that have strings after the link name
  34. #         found in Viewport
  35. #Changes: March 12 1994 MJW
  36. #         Allow Link whereever I allow link -after Steve Gowdy's suggestion-
  37. #Changes: April 22 1994 MJW
  38. #         Major rewrite?
  39. #         for Daniel Barrett, @{"mybutton" system "more myfile"} -> <A HREF="myfile">mybutton</A>
  40. #          THE next version will handle pictures in AmigaReport files automatically, but that may be a few days off.
  41. #          Picture conversions done
  42. #          Automatic inlining of pictures done for ones like the following 
  43.  
  44. #UNHANDLED?: @{"Lynx" system "display.s 10,100,AR215_pic1.iff,Lynx"} is a user-friendly hypertext interface on UNIX and VMS 
  45. #UNHANDLED?: The @{"Commodore Amiga Information Resource" system "display.s 10,100,AR215_pic2.iff,CAIR"} is a collection 
  46. #UNHANDLED?: - @{"Amiga Report" system "display.s 10,100,AR215_pic3.iff,AR on the WWW"}
  47.  
  48. #Changes May 28th 1994
  49. # Amiga report changed to display like this:
  50. # @{" AR Logo " system "display.s 650 100 AR217_pic2.iff Amiga_Report"}
  51. # Change it to handle that too.
  52. # June 9th ---- Changed pointer to itself
  53. # June 18th ---- version numbers, so I can tell people when it changes
  54. # June 28th ---- try to tolower links so they work for gowdy
  55. # Nov 23 1994 Fixed to work under perl 5, but bug handling multiple links
  56. # on one line persists! I wish they wouldn't do that.
  57. # (fixed for Waldemar Zurowski)
  58. #
  59. # Nov 26 1994 Incorporated Bilbo (Waldemar)'s changes to handle multiple links
  60. # in a line properly. Thanks Waldemar!.
  61. #In real       : Waldemar Zurowski
  62. #email internet: WALDEK@PLEARN.EDU.PL or bilbo@ci.pwr.wroc.pl
  63. #<A HREF="http://sun10.ci.pwr.wroc.pl/~bilbo/">Bilbo</A>
  64. #
  65. # Nov 26 1994 b. Fixed strange links with commas
  66. # UNHANDLED?:                           @{"  North America  ", link P6-3-3}
  67. # Nov 26 1994 c. Tidied up IFF handling
  68.  
  69. sub handlenode{
  70.     while (<guidef>){
  71.         chop;
  72.         if (m/\@[eE][nN][dD][Nn][oO][dD][Ee]/){
  73.         # print "Found \@endnode\n";            # found @endnode
  74.         print pagef "</pre>\n"; # 
  75.         if ($buttonline ne "<HR>") { print pagef "$buttonline"; }
  76.         print pagef "<HR>HTML Conversion by <a href=\"http://www.cs.cmu.edu:8001/Web/People/mjw/Computer/Amiga/Perl/AG2HTML.pl\"><i>AG2HTML.pl</i></a> V${VERSION}, perl $] & <a href=\"http://www.cs.cmu.edu:8001/Web/People/mjw/mjwhome.html\"><i>witbrock\@cs.cmu.edu</i></a>\n";
  77.         close (pagef);    # 
  78.         last;        # 
  79.         } else {
  80.         # Remember TOC link, and delete the line if found
  81.         if (m/\@[tT][oO][cC]\s*"?([^\"\s\}]*)"?/){
  82.         ($tmp=$1) =~ y/A-Z/a-z/;
  83.         $buttonline = $buttonline."<a href=\"${tmp}\.HTML\">[Contents]<\/a> ";
  84.         next;        # 
  85.         }            # 
  86.         # Remember prev link, and delete the line if found
  87.         if (m/\@[pP][rR][eE][vV]\s*"?([^\"\s\}]*)"?/){
  88.         ($tmp =$1) =~ y/A-Z/a-z/;
  89.         $buttonline = $buttonline."<a href=\"${tmp}\.HTML\">[Browse <-]<\/a> ";
  90.         next;
  91.         }
  92.         # Remember next link, and delete the line if found
  93.         if (m/\@[nN][eE][xX][tT]\s*"?([^\"\s\}]*)"?/){
  94.         ($tmp =$1) =~ y/A-Z/a-z/;
  95.         $buttonline = $buttonline."<a href=\"${tmp}\.HTML\">[Browse ->]<\/a> ";
  96.         next;
  97.         }
  98.         # Remember help link, and delete the line if found
  99.         if (m/\@[hH][eE][lL][pP]\s*"?([^\"\s\}]*)"?/){
  100.         ($tmp =$1) =~ y/A-Z/a-z/;
  101.         $buttonline = $buttonline."<a href=\"${tmp}\.HTML\">[Help]<\/a> ";
  102.         next;
  103.         }
  104.         # otherwise look for more calls, links, or plain text
  105.         study;
  106.         s/&/&/g;
  107.         s/>/>/g;
  108.         s/</</g;
  109.         # Handle pictures (as inline maybe change eventually)
  110.         s/\@\{\s*\"([^\"]*)\"\s+[sS][yY][Ss][tT][eE][mM]\s+\"displa\S* [0-9,\s]*(\S*)\.iff[,\s]*([^\"\}]*)\"*\s*\}/<p>\<img src=\"$2\.gif\"\><br>$3<p>$1/g;
  111.  
  112.         # for Daniel Barrett, \@{"mybutton" system "more myfile"} -> <A HREF="myfile">mybutton</A>
  113.         s/\@\{\s*\"([^\"]*)\"\s+[sS][yY][Ss][tT][eE][mM]\s+\"more *([^\"\s\}]*)\"*\s*\}/\<a href=\"$2\"\>$1<\/a>/;
  114.         #link - FROM BILBO: Here are my changes - I replaced 3 ifS with 
  115.         #       whileS and remove 'g' option after s/PATTERN/PATTERN/
  116.         while (m/\@\{\s*\"([^\"]*)\"[\s,]+[Ll][iI][nN][kK]\s+\"*([^\"\s\}]*)\"*\s*\}/){
  117.         ($link = $2) =~ y/A-Z/a-z/; # 
  118.         s/\@\{\s*\"([^\"]*)\"[\s,]+[Ll][iI][nN][kK]\s+\"*([^\"\s\}]*)\"*\s*\}/\<a href=\"${link}\.HTML\"\>$1<\/a>/; #HERE WAS 'G' OPTION
  119.         }
  120.         # found in viewport -- link with string after don't know what means
  121.            while (m/\@\{\s*\"([^\"]*)\"[\s,]+[Ll][iI][nN][kK]\s+\"*([^\"\s\}]*)\"*\s*\"[^\"]*\"\s*\}/) {
  122.         ($link = $2) =~ y/A-Z/a-z/; # 
  123.         s/\@\{\s*\"([^\"]*)\"[\s,]+[Ll][iI][nN][kK]\s+\"*([^\"\s\}]*)\"*\s*\"[^\"]*\"\s*\}/\<a href=\"${link}\.HTML\"\>$1<\/a>/; #HERE WAS 'G' OPTION
  124.             }
  125.         # found in kingcon -- link with number after don't know what means
  126.             while (m/\@\{\s*\"([^\"]*)\"[\s,]+[Ll][iI][nN][kK]\s+\"*([^\"\s\}]*)\"*\s*[0123456789]*\s*\}/) {
  127.         ($link = $2) =~ y/A-Z/a-z/; # 
  128.         s/\@\{\s*\"([^\"]*)\"[\s,]+[Ll][iI][nN][kK]\s+\"*([^\"\s\}]*)\"*\s*[0123456789]*\s*\}/\<a href=\"${link}\.HTML\"\>$1<\/a>/;#HERE WAS 'G' OPTION
  129.             }
  130.         s/\@\{[bB]\}/<B>/g;  s/\@\{[uU][bB]\}/<\/B>/g; # bold
  131.         s/\@\{[iI]\}/<I>/g;  s/\@\{[uU][iI]\}/<\/I>/g; #italic
  132.         if (m/\@\{/) {        # Recognise and hide unhandled cases 
  133.         print "UNHANDLED?: $_\n";
  134.         s/(\@\{[^\}]*\})/<!- Unhandled AmigaGuide(TM) sequence "$1">/g;
  135.         }                   
  136.         print pagef  "$_\n";
  137.         }
  138.     }
  139. }
  140.  
  141. die "Usage: %0 <AmigaGuideFile> $!\n N.B. This program puts AG node HTML files in a dir.\n"
  142.     unless ( $#ARGV == 0 );
  143. $agname = $ARGV[0]; $_ = $agname;
  144. if (/(.*)\.guide/){
  145.   $root = $1;
  146. } else {
  147.   die "Error: $agname doesn't seem to be an AmigaGuide(TM) file.\n";
  148. }
  149.  
  150. $dirname = $root."_Sections";
  151. mkdir($dirname,oct(777)) unless (-e $dirname);
  152. die "Couldn't make $dirname \n" unless -e $dirname;
  153. open (guidef, $agname) || die "Can't open $agname: $!\n";
  154.      
  155. $databasefound=0;
  156. # Move suitably labelled pictures to go with the file
  157. @iffs = <${root}_*.iff>;
  158. if (defined(@iffs)){
  159.     $ciff = $#iffs+1;
  160.     print "# Moving $ciff iff files: @iffs \n";
  161.     system ("mv ${root}_\*\.iff $dirname");
  162. }
  163. # Convert them to something mosaic can handle
  164. opendir(sect,$dirname) || die "Can't read dir $dirname\n";
  165. while ($_ = readdir(sect)){
  166.     next unless m#(.*)\.iff#;
  167.     print "Converting picture $1 to gif \n" unless -e  "${dirname}/$1.gif";
  168.     print "Founded gif version of picture $1 \n" if -e  "${dirname}/$1.gif";
  169.     system("ilbmtoppm < ${dirname}/$1.iff | ppmtogif > ${dirname}/$1.gif")
  170.     unless -e  "${dirname}/$1.gif";
  171.  
  172. }
  173. closedir(sect);
  174.     
  175. while (<guidef>) {
  176.     chop;
  177.     if ((m/\@[dD][Aa][Tt][Aa][bB][aA][sS][eE]\s*"(.*)"/)
  178.     || (m/\@[dD][Aa][Tt][Aa][bB][aA][sS][eE]\s*(\S*)/)){
  179.     if ($databasefound != 0) {
  180.         print "IGNORED: database label $1 found after first one $database\n";
  181.         next;
  182.     }
  183.     $databasefound = 1;
  184.     $database=$1;
  185.     print "Database: $database\n";
  186.     while (<guidef>){
  187.         chop;
  188.         $nodetitle="Untitled";
  189.         $buttonline = "<HR>";
  190.         if ( (m/\@[Nn][oO][dD][Ee]\s*"(\S*)"\s*"(.*)"/)
  191.         || (m/\@[Nn][oO][dD][Ee]\s*(\S*)\s*"(.*)"/)
  192.         || (m/\@[Nn][oO][dD][Ee]\s*(\S*)/)
  193.         ){  
  194.         # found \@Node LABEL "title"
  195.         # or just \@node Label or even \@node "label" "title"
  196.         $nodename = $1;
  197.         $nodetitle = $2;
  198.         $htmlname = $dirname."/".$1.".HTML";
  199.         if (-e $htmlname) {
  200.             unlink($htmlname);
  201.         }
  202.         open (pagef,'>'.$htmlname)
  203.             || die "Can't open $htmlname to write $!\n";
  204.         print pagef "<HTML>\n<TITLE>$nodetitle</TITLE>\n";
  205.         print pagef "<H1>$nodetitle</H1>\n<pre>\n";
  206.         last;
  207.         } else {
  208.         if (m/^.*\S.*$/) {
  209.             print "# SKIPPED while looking for \@node: $_ \n";
  210.         }
  211.         next;
  212.         }
  213.     }   # Found first @node line
  214.     print "NOTE: main node is $htmlname\n";
  215.     # Now look for end of first node
  216.     &handlenode;
  217.     # found end of first node, or of the file     
  218.     } else { # No database label on this line 
  219.     if ($databasefound == 0){  # stuff before first @database is ignored
  220.         print "#SKIPPED while looking for database: $_\n";
  221.         next;
  222.     }
  223.     # otherwise, it may be a perfectly good line
  224.     # check whether it is the start of a new node
  225.     $nodetitle="Untitled";
  226.     $buttonline = "<HR>";
  227.     if ( (m/\@[Nn][oO][dD][Ee]\s*"(\S*)"\s*"(.*)"/)
  228.         || (m/\@[Nn][oO][dD][Ee]\s*(\S*)\s*"(.*)"/)
  229.         || (m/\@[Nn][oO][dD][Ee]\s*(\S*)/)
  230.         ){  # found @Node LABEL "title", @node Label, or even @node "label" "title"
  231.         $nodename = $1;
  232.         $nodetitle = $2;
  233.         $nodename =~ y/A-Z/a-z/;
  234.         $htmlname = $dirname."/".$nodename.".HTML";
  235.         unlink($htmlname) if -e $htmlname;
  236.         open (pagef,'>'.$htmlname)
  237.         || die "Can't open $htmlname to write $!\n";
  238.         print pagef "<HTML>\n<TITLE>$nodetitle</TITLE>\n";
  239.         print pagef "<H1>$nodetitle</H1>\n<pre>\n";
  240.         
  241.         # print "Found Node: $nodename $nodetitle as $htmlname \n";
  242.         # since we found the beginning of the node, copy to the end
  243.         &handlenode;
  244.     } else {   # Haven't yet found a @node
  245.         if (m/^.*\S.*$/) {
  246.               print "# SKIPPED while looking for \@node: $_ \n";
  247.            }
  248.         next;
  249.     }
  250.     }
  251. }
  252. # 
  253. # 
  254.  
  255. close guidef;
  256.  
  257. # </listing>
  258.